 sbtl 'prodos machine language interface'
 org orig1 
* * * * * * * * * * * * * * * * *
*    the xdos machine language  *
*         interface (mli)       *
*      system call processor    *
* * * * * * * * * * * * * * * * *
*
 ifeq os-ednet
*
************** see en#1 ***************
*
 cld  ; this is the entry for the disk ii rwts.
 jmp $ff90 ;
***************************************
*
************ see rev note #en3 ****************
*
 msb off
 asc "(C)APPLE'83"
*
** the following address table consists of entry points into appletalk
** resident in the aux lc.  at load time, it is copied from a table in
** the file commands in the atp drivers where it resides at $d000, alc.
*
atalktbl equ *
 ds 32,0 ; reserve space for 16 entry points.
*
************************************************
*
 fin
entrymli cld ;cannot deal with decimal mode!!!
 pla ;get processor status
 sta spare1 ;save it on the global page temporarily
 sty savey ;preserve the y and x registers.
 stx savex
 pla ;find out the address of the caller.
 sta par
 clc ;and preserve the address of the call spec.
 adc #4 
 sta cmdadr
 pla
 sta par+1
 adc #0
 sta cmdadr+1 ;cmdadr is in the globals.
 lda spare1
 pha
 plp ;pull processor to re-enable interrupts
 cld  ; no decimal! (** #46 **)
 ldy #0
 sty serr ;clear any previous errors...
 iny ;find out if we've got a valid command.
 lda (par),y ;get command #
 lsr a ;hash it to a range of 0-$1f.
 lsr a
 lsr a
 lsr a
 clc
 adc (par),y
 and #$1f
 tax
 lda (par),y ;now see if result is a valid command number.
 cmp scnums,x ;should match if it is.
 bne scnerr ;branch if not.
 iny ;index to call spec parm list addr.
 lda (par),y ;make par point to parameter count byte 
 pha ;  in parameter block. 
 iny
 lda (par),y
 sta par+1
 pla
 sta par
 ldy #c.pcnt ;now make sure parameter list has the
 lda pcntbl,x ;  proper number of parameters 
 beq goclock ;clock has 0 parameters
 cmp (par),y
 bne scperr ;report error if wrong count.
 page
 lda scnums,x ;get call number again.
 cmp #$65
 beq special
 asl a ;carry set if bfm or dev mgr.
 bpl godevmgr
 bcs gobfmgr
 lsr a ;shift back down for interupt mgr.
 and #$3 ;valid calls are 0 & 1
 jsr intmgr
 jmp exitmli ;command processed, all done.
*
special equ *
 jmp jspare
*
goclock jsr datetime ;go read clock.
 jmp exitmli ;no errors posible!
*
godevmgr lsr a ;save command #
 adc #1 ;valid commands are 1 & 2
 sta dhpcmd
 jsr devmgr ;execute read or write request.
 jmp exitmli
*
gobfmgr lsr a
 and #$1f ;valid commands in range of 0-$13
 tax 
 jsr bfmgr ;go do it...
*
exitmli lda #0 ;first clear bubit. 
 sta bubit ;(back up bit)
 ldy serr ;y holds error code thru most of exit. 
 cpy #1 ;if >0 then set carry 
 tya ; and set z flag. 
 php ;disable interupts until exit complete. 
 sei
 lsr mliactv ;indicate mli done.(** #46 **) (** #85 **)
 pla ;save status register elswhere
 tax ; until return address is placed
 lda cmdadr+1 ; on the stack.
 pha
 lda cmdadr ;returning is done via 'rti'
 pha ; so that the status register is
 txa ; restored at the same time.
 pha ;place status back on the stack.
 tya ;return error, if any.
 ldx savex ;restore x & y registers.
 ldy savey
exitrpm pha  ; (exit point for rpm **en3**)
 lda bnkbyt1 ;restore language card status & return.
 jmp exit
*
gnodev lda #xnodrv ;report no device connected.
 jsr syserr
* 
scnerr lda #badscnum ;report no such command.
 bne scerr1 ;branch always
*
scperr lda #badscpcnt ;report parameter count is invalid.
scerr1 jsr gosyserr 
 bcs exitmli ;branch always taken.
*
 sbtl 'prodos device manager'
devmgr ldy #5 ;the call spec for devices must
 php ;do not allow interupts.
 sei
dvmgr1 lda (par),y ; be passed to drivers in zero page.
 sta dhpcmd,y ;dhpcmd,unitnum,bufptr,blocknum.
 dey
 bne dvmgr1
 ldx dbufph
 stx usrbuf+1
 inx
 inx ;add 2 for 512 byte range 
 lda dbufpl ;is buffer page alligned?
 beq dvmgr2 ;branch if it is.
 inx ;else account for 3-page straddle...
dvmgr2 jsr vldbuf1 ;make sure user is not conflicting
 bcs dvmgrerr ; with protected ram
 jsr dmgr ;call internal entry for device dispatch.
 bcs dvmgrerr ;branch if error occured.
 plp
 clc ;make sure carry is clear (no error)
gl.rts rts
dvmgrerr plp ;restore interupt status.
gosyserr jsr syserr
*
*
*  NOTE: interrupts must always be off when entering here
*
dmgr lda unitnum ;get device number.
 and #$f0 ;strip misc lower nibble
 sta unitnum ;  and save it back.
 lsr a ;use as index to device table.
 lsr a
 lsr a
 tax
 lda devadr01,x ;fetch driver address.
 sta goadr
 lda devadr01+1,x
 sta goadr+1
 jmp (goadr) ;goto driver (or error if no driver)
 nop
 nop
 nop
 rts
*
 sbtl 'prodos interrupt manager'
intmgr equ *
 sta intcmd ;allocate intrupt or deallocate?
* -------------------- see rev note 20 ---------------------------
***************** see rev note #en3 *****************
 cmp #2 ;alloc & dealloc = 0 & 1; 2 = atalk
 bcc intmgr1
 ifeq os-prodos
 jsr dobus ; go set up and call atp drivers.
 fin
 ifeq os-ednet
 ldx par ; x and y must be used to call atp since 
 ldy par+1 ; main zero page is not in when atp runs.
 inx  ; inc parameter list pointer by one
 bne par1 ; to bypass the dummy length field.
 iny  ;
par1 equ *
 php  ; now we must set up the stack the way 
 pha  ; the bridge routine wants it....
 txa  ;
 pha  ;
 lda #0 ; offset into atalk address table for atp.
 jsr bridge ; go call atp drivers...
 fin
 bcs interr1 ;signify error
 rts
intmgr1 equ *
* ---------------------------------------------------------------
 lsr a ;(acc=0, carry set=dealloc)
 bcs dealcint ;branch if deallocation.
 ldx #3 ;test for a free interupt space in table.
alcint lda intrupt1-2,x ;test high addr for zero.
 bne alcint1 ;branch if spot occupied. 
 ldy #c.intadr+1 ;fetch address of routine.
 lda (par),y ;must not be in zero page!!!!
 beq badint ;branch if the fool tried it.
 sta intrupt1-2,x ;save high address
 dey
 lda (par),y
 sta intrupt1-3,x ;and low address.
 txa ;now return interupt # in range of 1 to 4.
 lsr a
 dey
 sta (par),y ;pass back to user.
 clc ;indicate success!
 rts
*
alcint1 inx
 inx ;bump to next lower priority spot.
 cpx #$b ;are all four allocated already?
 bne alcint ;branch if not.
*
 lda #intblful ;return news that four devices are active.
 bne interr1
*
badint lda #badlstcnt ;report invalid parameter.
interr1 jsr syserr 
*
* 
dealcint ldy #c.intnum ;zero out interupt vector.
 lda (par),y ;but make sure it is valid #
 beq badint ;branch if it's <1
 cmp #5 ; or >4
 bcs badint
 asl a
 tax
 lda #0 ;now zip it.
 sta intrupt1-2,x
 sta intrupt1-1,x
 clc
 rts
 page
irqrecev equ *
 lda $45 ;get acc from 0-page where old rom put it
 sta intareg
 stx intxreg ;entry point on ram card interupt 
 sty intyreg
 tsx
 stx intsreg
 lda irqflag ;irq flag byte = 0 if old roms
 bne irqrcv1 ;  and 1 if new roms
 pla
 sta intpreg
 pla
 sta intaddr
 pla
 sta intaddr+1
irqrcv1 txs ;restore return addr & p-reg to stack
 lda $7f8 ;set up to re-enable $cn00 rom. 
 sta irqdev+2  
 tsx ;make sure stack has room for 16 bytes
 bmi nostsve ;branch if stack safe.
 ldy #$f
stksve pla
 sta svstack,y
 dey
 bpl stksve
nostsve ldx #$fa ;save 6 bytes of zero page
zpgsve lda $0,x
 sta svzerop-$fa,x
 inx
 bne zpgsve
*
* poll interupt routines for a claimer.
*
 lda intrupt1+1 ;test for valid routine.
 beq intr2 ;branch if no routine.
 jsr goint1
 bcc irqdone
intr2 lda intrupt2+1 ;test for valid routine.
 beq intr3 ;branch if no routine.
 jsr goint2 ;execute routine.
 bcc irqdone
intr3 lda intrupt3+1 ;test for valid routine.
 beq intr4 ;branch if no routine.
 jsr goint3 
 bcc irqdone
intr4 lda intrupt4+1 ;test for valid routine.
 ifeq os-prodos
 beq irqdeath 
 fin
 ifeq os-ednet
 beq intr5 ;branch and check if atalk interrupt..
 fin
 jsr goint4 ;execute routine.
 bcc irqdone
*
**************** see rev note #en3 **************
*
* the following code pre-installs the appletalk interrupt handler.
* this is done so as not to take up a user interrupt space.
* note that registers are saved and restored by prodos.
*
 ifeq os-ednet
intr5 equ *
 inc $410 ; ** for debug purposes only...
 php  ; now set up stack for bridge....p....
 pha  ; a...
 tax  ; x...
 pha  ; 
 lda #4 ; offset into atalk address table for atp
 bit $ff58 ; set overflow to signify bridge called during interrupts.
 jsr bridge ; interrupt handler.
 bcc irqdone ; if carry clear, then interrupt processed
 fin
*************************************************
*
*************** see rev note #35 *************************
irqdeath inc irqcount ; allow 255 unclaimed interrupts before
 bne irqdone ; going to system death...
**********************************************************
*
 lda #badirq ;kill the system, no one claimed the interupt.
 jsr sysdeath
*
*
irqdone ldx #$fa
irqdne1 lda svzerop-$fa,x ;restore zero page stuff.
 sta $0,x
 inx
 bne irqdne1
 ldx intsreg ;test for necessity of restoring stack elements.
 bmi irqdne3
 ldy #$00
irqdne2 lda svstack,y
 pha
 iny
 cpy #$10
 bne irqdne2
irqdne3 equ *
 lda irqflag ;check for old roms
 bne irqdne ;branch if new roms
 ldy intyreg ;restore registers.
 ldx intxreg
 lda $cfff ;re-enable i/o card 
irqdev lda $c100 ;warning, self modified. 
 lda irqdev+2 ;restore device id
 sta $7f8 ;just in case...
irqdne jmp irqxit ;do necessary bank switches and return.
*
irqflag dfb 0 ;irq flag byte. 0=old roms; 1=new roms
irqcount db 0 ; unclaimed interrupt counter.(note #35)
*
goint1 jmp (intrupt1)
goint2 jmp (intrupt2)
goint3 jmp (intrupt3)
goint4 jmp (intrupt4)
 page
*
syserr1 sta serr
 pla
 pla ;pop 1 level of return.
 lda serr
 sec
 rts
*
line23 equ $750
line24 equ $7d0
*
*
*************** see rev note #36 **************************
*
*sys.end lda #0 ;no error code, intentional cold start needed
sysdeath1 tax ;system death!!!
 sta $c00c ;force 40 columns on rev-e.
 lda $c051 ; text mode on.
*
**************** see rev note #61 **************************
*
 lda cortflag ;check if we're on a cortland
 beq nosuphires ;if not, don't touch shires switch
 lda #0 ;jam all bits off in shires video byte
 sta $c029 ;force off super hires
nosuphires equ *
*
************************************************************
*
* lda $c053 ; go to mixed mode (if above switch was for graphics!)
 lda $c054 ; display page 1 on.
* lda $c056 ; go to low res mode (if graphics enabled).
 ldy #$27 ;move 40 characters
dsdeath lda #$a0 ;blank second to the bottom line
 sta line23,y
 lda death,y
 sta line24,y
 dey
 bpl dsdeath
* txa 
* beq halt 
* lda #'-'+$80
* sta line24+$21
* lda #'e'+$80 ;put err in death line if
* sta line24+$22 ;  sysdeath caused by an error
* lda #'r'+$80 
* sta line24+$23 
* sta line24+$24 
* txa
* lsr a
* lsr a
* lsr a
* lsr a
* ora #$b0
* cmp #$ba
* bcc pq1 ;branch if not >9
* adc #$6 ;bump to alpha a-f
*pq1 sta line24+$26 
***********************************************************
 txa
 and #$f
 ora #$b0
 cmp #$ba
 bcc pq ;branch if not >9
 adc #$6 ;bump to alpha a-f
pq sta line24+$27
halt jmp halt ;hold forever.
*
